home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / files.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  27KB  |  894 lines
  1. {
  2.     $Id: files.pas,v 1.1.1.1 1998/03/25 11:18:12 root Exp $
  3.     Copyright (c) 1996-98 by Florian Klaempfl
  4.  
  5.     This unit implements an extended file management and the first loading
  6.     and searching of the modules (ppufiles)
  7.  
  8.     This program is free software; you can redistribute it and/or modify
  9.     it under the terms of the GNU General Public License as published by
  10.     the Free Software Foundation; either version 2 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     This program is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU General Public License
  19.     along with this program; if not, write to the Free Software
  20.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  ****************************************************************************
  23. }
  24. unit files;
  25.  
  26.   interface
  27.  
  28.     uses
  29.        cobjects,globals;
  30.  
  31.     const
  32. {$ifdef FPC}
  33.        maxunits = 1024;
  34. {$else}
  35.        maxunits = 128;
  36. {$endif}
  37.  
  38.     type
  39.        pextfile = ^textfile;
  40.  
  41.        { this isn't a text file, this is t-ext-file }
  42.        { which means a extended file                }
  43.        { this files can be handled by a file        }
  44.        { manager                                    }
  45.        textfile = object(tbufferedfile)
  46.           path,name,ext : pstring;
  47.           { this is because there is a name conflict }
  48.           { with the older next from tinputstack     }
  49.           _next : pextfile;
  50.           { 65000 input files for a unit should be enough !! }
  51.           ref_index : word;
  52.  
  53.           { p must be the complete path (with ending \ (or / for unix ...) }
  54.           constructor init(const p,n,e : string);
  55.           destructor done;virtual;
  56.        end;
  57.  
  58.        pinputfile = ^tinputfile;
  59.  
  60.        tinputfile = object(textfile)
  61.           filenotatend : boolean;
  62.           line_no : longint;
  63.           { second counter for unimportant tokens }
  64.           line_count : longint;
  65.           { next input file in the stack of input files }
  66.           next : pinputfile;
  67.           { to handle the browser refs }
  68.           ref_count : longint;
  69.  
  70.           constructor init(const p,n,e : string);
  71.           { writes the file name and line number to t }
  72.           procedure write_file_line(var t : text);
  73.           function get_file_line : string;
  74.        end;
  75.  
  76.        pfilemanager = ^tfilemanager;
  77.  
  78.        tfilemanager = object
  79.           files : pextfile;
  80.           last_ref_index : word;
  81.           constructor init;
  82.           destructor done;
  83.           procedure close_all;
  84.           procedure register_file(f : pextfile);
  85.        end;
  86.  
  87.        pimported_procedure = ^timported_procedure;
  88.  
  89.        timported_procedure = object(tlinkedlist_item)
  90.           ordnr : word;
  91.           name,func : pstring;
  92.           { should be plabel, but this gaves problems with circular units }
  93.           lab : pointer;
  94.           constructor init(const n,s : string;o : word);
  95.           destructor done;virtual;
  96.        end;
  97.  
  98.        pimportlist = ^timportlist;
  99.  
  100.        timportlist = object(tlinkedlist_item)
  101.           dllname : pstring;
  102.           imported_procedures : plinkedlist;
  103.           constructor init(const n : string);
  104.           destructor done;virtual;
  105.        end;
  106.  
  107.     type
  108.        pmodule = ^tmodule;
  109.        pused_unit = ^tused_unit;
  110.  
  111.        tused_unit = object(tlinkedlist_item)
  112.           u : pmodule;
  113.           in_uses, in_interface, is_stab_written : boolean;
  114.           unitid : word;
  115.           constructor init(_u : pmodule;f : byte);
  116.           destructor done;virtual;
  117.        end;
  118.  
  119.        tunitmap = array[0..maxunits-1] of pointer;
  120.        punitmap = ^tunitmap;
  121.  
  122.        tmodule = object(tlinkedlist_item)
  123.  
  124.           { the PPU file }
  125.           ppufile : pextfile;
  126.           { used for global switches - in_main section after uses clause }
  127.           { then TRUE else false.                                        }
  128.           in_main : boolean;
  129.           { mapping of all used units }
  130.           map : punitmap;
  131.           { local unit counter }
  132.           unitcount : word;
  133.           { this is a pointer because symtable uses this unit }
  134.           { it should be psymtable                            }
  135.           symtable : pointer;
  136.  
  137.           { PPU version, handle different versions }
  138.           ppuversion : longint;
  139.  
  140.           { check sum written to the file }
  141.           crc : longint;
  142.  
  143.           { flags }
  144.           flags : byte;
  145.  
  146.           {Set if the module imports from DLL's.}
  147.           uses_imports:boolean;
  148.  
  149.           imports : plinkedlist;
  150.  
  151.           { how to write this file }
  152.           output_format : tof;
  153.  
  154.           { for interpenetrated units }
  155.           in_implementation,
  156.           compiled,
  157.           do_assemble,
  158.           do_compile,              { true, if it's needed to compile the sources }
  159.           sources_avail : boolean; { true, if all sources are reachable }
  160.  
  161.           { only used, if the module is compiled by this compiler call }
  162.           sourcefiles : tfilemanager;
  163.           linklibfiles,
  164.           linkofiles  : tstringcontainer;
  165.           used_units  : tlinkedlist;
  166.           current_inputfile : pinputfile;
  167.  
  168.           unitname,               { name of the (unit) module }
  169.           objfilename,            { fullname of the objectfile }
  170.           asmfilename,            { fullname of the assemblerfile }
  171.           ppufilename,            { fullname of the ppufile }
  172.           mainsource   : pstring; { name of the main sourcefile }
  173.  
  174.           constructor init(const s:string;is_unit:boolean);
  175.           { this is to be called only when compiling again }
  176.           destructor special_done;virtual;
  177.  
  178.           function load_ppu(const unit_path,n,ext : string):boolean;
  179.           procedure search_unit(const n : string);
  180.        end;
  181.  
  182.     const
  183.        main_module : pmodule = nil;
  184.        current_module : pmodule = nil;
  185.  
  186.     var
  187.        loaded_units : tlinkedlist;
  188.  
  189.     type
  190.        tunitheader = array[0..19] of char;
  191.  
  192.     const
  193.                                    {                compiler version }
  194.                                    {             format      |       }
  195.                                    { signature    |          |       }
  196.                                    {  |           |          |       }
  197.                                    { /-------\   /-------\  /----\   }
  198.        unitheader : tunitheader  = ('P','P','U','0','1','3',#0,#99,
  199.                                      #0,#0,#0,#0,#0,#0,#255,#255,
  200.                                    { |   | \---------/ \-------/    }
  201.                                    { |   |    |             |        }
  202.                                    { |   |    check sum     |        }
  203.                                    { |   \--flags        unused      }
  204.                                    { target system                   }
  205.                                     #0,#0,#0,#0);
  206.                                    {\---------/                      }
  207.                                    {  |                              }
  208.                                    {  start of machine language      }
  209.  
  210.     const
  211.        ibloadunit = 1;
  212.        iborddef = 2;
  213.        ibpointerdef = 3;
  214.        ibtypesym = 4;
  215.        ibarraydef = 5;
  216.        ibprocdef = 6;
  217.        ibprocsym = 7;
  218.        iblinkofile = 8;
  219.        ibstringdef = 9;
  220.        ibvarsym = 10;
  221.        ibconstsym = 11;
  222.        ibinitunit = 12;
  223.        ibaufzaehlsym = 13;
  224.        ibtypedconstsym = 14;
  225.        ibrecorddef = 15;
  226.        ibfiledef = 16;
  227.        ibformaldef = 17;
  228.        ibobjectdef = 18;
  229.        ibenumdef = 19;
  230.        ibsetdef = 20;
  231.        ibprocvardef = 21;
  232.        ibsourcefile = 22;
  233.        ibdbxcount = 23;
  234.        ibfloatdef = 24;
  235.        ibref = 25;
  236.        ibextsymref = 26;
  237.        ibextdefref = 27;
  238.        ibabsolutesym = 28;
  239.        ibclassrefdef = 29;
  240.        ibpropertysym = 30;
  241.        iblibraries = 31;
  242.        iblongstringdef = 32;
  243.        ibansistringdef = 33;
  244.        ibend = 255;
  245.  
  246.        { unit flags }
  247.        uf_init = 1;
  248.        uf_uses_dbx = 2;
  249.        uf_uses_browser = 4;
  250.        uf_in_library = 8;
  251.        uf_shared_library = 16;
  252.        uf_big_